home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / site / LWP / Protocol / mailto.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  1.8 KB  |  78 lines
  1.  
  2. package LWP::Protocol::mailto;
  3.  
  4. require LWP::Protocol;
  5. require HTTP::Request;
  6. require HTTP::Response;
  7. require HTTP::Status;
  8.  
  9. use Carp;
  10.  
  11. @ISA = qw(LWP::Protocol);
  12.  
  13. $SENDMAIL = "/usr/lib/sendmail";
  14.  
  15.  
  16. sub request
  17. {
  18.     my($self, $request, $proxy, $arg, $size) = @_;
  19.  
  20.     if (defined $proxy)
  21.     {
  22.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  23.                   'You can not proxy with mail';
  24.     }
  25.  
  26.     $method = $request->method;
  27.  
  28.     if ($method ne 'POST') {
  29.     return new HTTP::Response &HTTP::Status::RC_BAD_REQUEST,
  30.                   'Library does not allow method ' .
  31.                   "$method for 'mailto:' URLs";
  32.     }
  33.  
  34.     my $url = $request->url;
  35.  
  36.     my $scheme = $url->scheme;
  37.     if ($scheme ne 'mailto') {
  38.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  39.                   "LWP::file::request called for '$scheme'";
  40.     }
  41.     unless (-x $SENDMAIL) {
  42.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  43.                   "You don't have $SENDMAIL";
  44.     }
  45.  
  46.     open(SENDMAIL, "| $SENDMAIL -oi -t") or
  47.     return new HTTP::Response &HTTP::Status::RC_INTERNAL_SERVER_ERROR,
  48.                   "Can't run $SENDMAIL: $!";
  49.  
  50.     my $addr = $url->encoded822addr;
  51.  
  52.     $request->header('To', $addr);
  53.     print SENDMAIL $request->headers_as_string;
  54.     print SENDMAIL "\n";
  55.     my $content = $request->content;
  56.     if (defined $content) {
  57.     my $contRef = ref($content) ? $content : \$content;
  58.     if (ref($contRef) eq 'SCALAR') {
  59.         print SENDMAIL $$contRef;
  60.     } elsif (ref($contRef) eq 'CODE') {
  61.         my $d;
  62.         while (length($d = &$contRef)) {
  63.         print SENDMAIL $d;
  64.         }
  65.     }
  66.     }
  67.     close(SENDMAIL);
  68.  
  69.     my $response = new HTTP::Response &HTTP::Status::RC_ACCEPTED,
  70.                      'Mail accepted by sendmail';
  71.     $response->header('Content-Type', 'text/plain');
  72.     $response->content("Mail sent to <$addr>\n");
  73.  
  74.     return $response;
  75. }
  76.  
  77. 1;
  78.